Utility.FileIO: set close-on-exec flag for all functions

Utility.FileIO.CloseOnExec is largely copied from
System.File.OsPath.Internal with the simple modification of
setting the flag.

Unfortunately, openTempFile does not set the flag when
opening the file, but afterwards, leaving it vulnerable to a race.
A lot of code, including posix and windows specific code,
would need to be copied from file-io in order to fix that.
Still, I consider this implementation a placeholder, it doesn't truely
fix all instances of the problem.

I hope that this will be addressed in file-io itself, see
https://github.com/haskell/file-io/issues/44

Utility.FileIO.CloseOnExec could form the basis of a
file-io-closeonexec library, depending on how things go with that
issue.

Sponsored-by: the NIH-funded NICEMAN (ReproNim TR&D3) project

diff --git a/COPYRIGHT b/COPYRIGHT
index 9dbafd6a742804720dc5aaadf22e7b5a05b33fef..1a083288e00850c47c81f3cd54a4183ec5082410 100644 (file)
--- a/COPYRIGHT
+++ b/COPYRIGHT
@@ -42,6 +42,11 @@ Copyright: 2019 Joey Hess <id@joeyh.name>
            2007-2015 Bryan O'Sullivan
 License: BSD-3-clause
 
+Files: Utility/FileIO/CloseOnExec.hs
+Copyright: 2025 Joey Hess <id@joeyh.name>
+           2024 Julian Ospald
+License: BSD-3-clause
+
 Files: Utility/Matcher.hs Utility/Tor.hs Utility/Yesod.hs
 Copyright: © 2010-2023 Joey Hess <id@joeyh.name>
 License: AGPL-3+
@@ -144,7 +149,7 @@ License: BSD-3-clause
     notice, this list of conditions and the following disclaimer in the
     documentation and/or other materials provided with the distribution.
  .
- 3. Neither the name of the author nor the names of his contributors
+ 3. Neither the name of the author nor the names of other contributors
     may be used to endorse or promote products derived from this software
     without specific prior written permission.
  .

diff --git a/Utility/FileIO.hs b/Utility/FileIO.hs
index 712877f0cb9e848e6e88fe52c3971702b6196eac..7c13d84925f5dbe5274fa936049c28fb12d0c4de 100644 (file)
--- a/Utility/FileIO.hs
+++ b/Utility/FileIO.hs
@@ -1,7 +1,10 @@
 {- This is a subset of the functions provided by file-io.
+ -
+ - All exported functions set the close-on-exec flag.
  -
  - When not building with file-io, this provides equvilant
- - RawFilePath versions.
+ - RawFilePath versions. Note that those versions do not currently
+ - set the close-on-exec flag.
  -
  - Since Prelude exports many of these as well, this needs to be imported
  - qualified.
@@ -33,7 +36,7 @@ module Utility.FileIO
 #ifdef WITH_OSPATH
 
 #ifndef mingw32_HOST_OS
-import System.File.OsPath
+import Utility.FileIO.CloseOnExec
 #else
 -- On Windows, System.File.OsPath does not handle UNC-style conversion itself,
 -- so that has to be done when calling it. See 
@@ -42,7 +45,7 @@ import Utility.Path.Windows
 import Utility.OsPath
 import System.IO (IO, Handle, IOMode)
 import Prelude (return)
-import qualified System.File.OsPath as O
+import qualified Utility.FileIO.CloseOnExec as O
 import qualified Data.ByteString as B
 import Control.Applicative
 
@@ -106,8 +109,7 @@ openTempFile p s = do
 #endif
 
 #else
--- When not building with OsPath, export RawFilePath versions
--- instead.
+-- RawFilePath versions
 import Utility.OsPath
 import Utility.FileSystemEncoding
 import System.IO (IO, Handle, IOMode)

diff --git a/Utility/FileIO/CloseOnExec.hs b/Utility/FileIO/CloseOnExec.hs
new file mode 100644 (file)
index 0000000..a638ea2
--- /dev/null
+++ b/Utility/FileIO/CloseOnExec.hs
@@ -0,0 +1,115 @@
+{- This is a subset of the functions provided by file-io.
+ - All functions have been modified to set the close-on-exec
+ - flag to True.
+ -
+ - Copyright 2025 Joey Hess <id@joeyh.name>
+ - Copyright 2024 Julian Ospald
+ -
+ - License: BSD-3-clause
+ -}
+
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Utility.FileIO.CloseOnExec
+(
+#ifdef WITH_OSPATH
+       withFile,
+       withFile',
+       openFile,
+       withBinaryFile,
+       openBinaryFile,
+       readFile,
+       readFile',
+       writeFile,
+       writeFile',
+       appendFile,
+       appendFile',
+       openTempFile,
+#endif
+) where
+
+#ifdef WITH_OSPATH
+
+import System.File.OsPath.Internal (withOpenFile', augmentError)
+import qualified System.File.OsPath.Internal as I
+import System.IO (IO, Handle, IOMode(..))
+import System.OsPath (OsPath, OsString)
+import Prelude (Bool(..), pure, either, (.), (>>=), ($))
+import Control.Exception
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
+#ifndef mingw32_HOST_OS
+import System.Posix.IO
+#endif
+
+closeOnExec :: Bool
+closeOnExec = True
+
+withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
+withFile osfp iomode act = (augmentError "withFile" osfp
+    $ withOpenFile' osfp iomode False False closeOnExec (try . act) True)
+  >>= either ioError pure
+
+withFile'
+  :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
+withFile' osfp iomode act = (augmentError "withFile'" osfp
+    $ withOpenFile' osfp iomode False False closeOnExec (try . act) False)
+  >>= either ioError pure
+
+openFile :: OsPath -> IOMode -> IO Handle
+openFile osfp iomode =  augmentError "openFile" osfp $
+       withOpenFile' osfp iomode False False closeOnExec pure False
+
+withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r
+withBinaryFile osfp iomode act = (augmentError "withBinaryFile" osfp
+    $ withOpenFile' osfp iomode True False closeOnExec (try . act) True)
+  >>= either ioError pure
+
+openBinaryFile :: OsPath -> IOMode -> IO Handle
+openBinaryFile osfp iomode = augmentError "openBinaryFile" osfp $
+        withOpenFile' osfp iomode True False closeOnExec pure False
+
+readFile :: OsPath -> IO BSL.ByteString
+readFile fp = withFile' fp ReadMode BSL.hGetContents
+
+readFile'
+  :: OsPath -> IO BS.ByteString
+readFile' fp = withFile fp ReadMode BS.hGetContents
+
+writeFile :: OsPath -> BSL.ByteString -> IO ()
+writeFile fp contents = withFile fp WriteMode (`BSL.hPut` contents)
+
+writeFile'
+  :: OsPath -> BS.ByteString -> IO ()
+writeFile' fp contents = withFile fp WriteMode (`BS.hPut` contents)
+
+appendFile :: OsPath -> BSL.ByteString -> IO ()
+appendFile fp contents = withFile fp AppendMode (`BSL.hPut` contents)
+
+appendFile'
+  :: OsPath -> BS.ByteString -> IO ()
+appendFile' fp contents = withFile fp AppendMode (`BS.hPut` contents)
+
+{- Unlike all other functions in this module, this only sets the
+ - close-on-exec flag after opening the file. Thus, it is vulnerable to
+ - races.
+ -
+ - Re-implementing openTempFile is difficult due to the current
+ - structure of file-io. See this issue for discussion about improving
+ - that: https://github.com/haskell/file-io/issues/44
+ - -}
+openTempFile :: OsPath -> OsString -> IO (OsPath, Handle)
+openTempFile tmp_dir template = do
+       (p, h) <- I.openTempFile tmp_dir template
+#ifndef mingw32_HOST_OS
+       fd <- handleToFd h
+       setFdOption fd CloseOnExec True
+       h' <- fdToHandle fd
+       pure (p, h')
+#else
+       pure (p, h)
+#endif
+
+#endif

diff --git a/git-annex.cabal b/git-annex.cabal
index 484e94abfdbf01fc421db23099d76e4e6d57660d..efa8b275e3912628009df71c24196855abcce3ad 100644 (file)
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -1148,6 +1148,7 @@ Executable git-annex
     Utility.Su
     Utility.SystemDirectory
     Utility.FileIO
+    Utility.FileIO.CloseOnExec
     Utility.Terminal
     Utility.TimeStamp
     Utility.TList